Regression models with R

Das Ziel ist es, aus dem Datacamp Datensatz Video Game Sales Date folgende Fragestellung / Hypothese zu beantworten:

Fragestellung: “Ist es wahrscheinlicher, dass sich bestimmte Spielgenres in Europa signifikant (Unterschied von 50%) besser verkaufen lassen als im Japanischen und Nordamerikanischen Markt?”

Als Einführung werden wir auf Datacamp folgende Kurse durchgehen:

• Introduction to Regression in R

• Intermediate Regression in R

# Import libraries
library("plotly")
library("ggplot2")
library("plyr")
library("dplyr")
library("broom")
library("gridExtra")   

# Read csv from folder "data"
df = read.csv("./data/video_games_data.csv")

head(df, 10)

Data Wrangling

Bevor wir mit den Visualisierungen und Modelle beginnen können, müssen wir die Daten säubern. Das heisst es sollte keine Duplikate geben, fehlende Werte sollten korrekt eingetragen werden und Daten, die nicht verwendet werden sollten gelöscht werden.

Es hat “N/A” Werte in den Spalten “Year” und “Publisher”. Diese Werte sollten korrekte “NA” Werte sein, damit sie bei den Visualisierungen und Berechnungen nicht berücksichtigt werden.

# Show rows with "N/A" values
df[grep("N/A", df$Publisher),]

df[grep("N/A", df$Year),]

# Replace "N/A" with "NA"
df[df == "N/A"] <- NA

df <- df %>%
  filter(df$Global_Sales > 0.1)

df

# Check if values have been converted
df %>% 
  summarize(across(everything(), ~sum(is.na(.))))

Da 2017 nur 3 Einträge und 2020 nur 1 Eintrag beinhaltet, werden wir diese Jahren nicht berücksichtigen und aus dem Dataframe löschen, weil sie nicht vollständig sind und so könnten unsere Modelle ungenau werden.

# Remove years 2017 and 2020 from dataset
df_clean <- df[!(df$Year == "2017" | df$Year == "2020"),]

# Remove unnecessary columns because they are not needed for our thesis
drop <- c("Rank")
df_clean <- df_clean[,!(names(df_clean) %in% drop)]

df_clean

# Set data to correct type
df_clean$Genre <- as.factor(df_clean$Genre)
df_clean$Year <- as.numeric(df_clean$Year)

Erste Plots erstellen

na <- sum(df_clean[, 'NA_Sales'], na.rm = TRUE)
eu <- sum(df_clean[, 'EU_Sales'], na.rm = TRUE)
jp <- sum(df_clean[, 'JP_Sales'], na.rm = TRUE)
o <- sum(df_clean[, 'Other_Sales'], na.rm = TRUE)
g <- sum(df_clean[, 'Global_Sales'], na.rm = TRUE)

fig <- plot_ly(
  y = c(na, eu, jp, o), 
  x = c("North America", "Europe", "Japan", "Other"), 
  type = 'bar',
  width = 800
)

fig <- fig %>% layout(title = "Video Game Sales Overview",
         xaxis = list(title = "Region"),
         yaxis = list(title = "Sales (million)"))

fig

Wir sehen, dass Nord Amerika der grösste Markt ist.

# Group by genre and summarize game sales to each region
df_genre <- df_clean %>%
  group_by(Genre) %>%
  summarize(
    NA_Sales_Sum = sum(NA_Sales),
    EU_Sales_Sum = sum(EU_Sales), 
    JP_Sales_Sum = sum(JP_Sales),
    Other_Sales_Sum = sum(Other_Sales),
    Global_Sales_Sum = sum(Global_Sales)
  )

# Plot grouped bar chart video game sales by genre
fig <- plot_ly(
  df_genre, y = ~Genre, x = ~NA_Sales_Sum, type = "bar", name = "North America", width = 1000, height = 800) %>% 
  add_trace(x = ~EU_Sales_Sum, name = "Europe") %>%
  add_trace(x = ~JP_Sales_Sum, name = "Japan") %>%
  add_trace(x = ~Other_Sales_Sum, name = "Other") %>%
  layout(
    title = "Video Game Sales by Genre",
    xaxis = list(title = "Sales (million)"),
    barmode = "group"
  )

fig

Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations

Japan hat viel mehr Role-Play, Strategie und viel weniger Shooter und Action als die anderen Regionen

df_year <- df_clean %>%
  group_by(Year) %>%
  summarize(
    NA_Sales_Sum = sum(NA_Sales),
    EU_Sales_Sum = sum(EU_Sales), 
    JP_Sales_Sum = sum(JP_Sales),
    Other_Sales_Sum = sum(Other_Sales),
    Global_Sales_Sum = sum(Global_Sales)
  )

fig <- plot_ly(
  df_year, y = ~NA_Sales_Sum, x = ~Year, type = "bar", name = "North America", width = 900, height = 500) %>% 
  add_trace(y = ~EU_Sales_Sum, name = "Europe") %>%
  add_trace(y = ~JP_Sales_Sum, name = "Japan") %>%
  add_trace(y = ~Other_Sales_Sum, name = "Other") %>%
  layout(
    title = "Video Game from Sales by Year",
    xaxis = list(title = "Year"),
    yaxis = list(title = "Sales (million)"),
    barmode = "stack"
  )

fig

Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations

# Calculate the average of sales of each genre from each region
df_sales_avg <- df_clean %>%
  group_by(Genre) %>%
  summarise(
    EU_Sales_Avg = mean(EU_Sales),
    NA_Sales_Avg = mean(NA_Sales),
    JP_Sales_Avg = mean(JP_Sales),
    Other_Sales_Avg = mean(Other_Sales),
    Global_Sales_Avg = mean(Global_Sales))

df_sales_avg

Hier sehen wir die durchschnittliche Anzhal von Verkäufe aller Genre

Regressionsmodelle

Da wir unsere Daten jetzt besser verstehen, können wir mit den Regressionsmodellen und mit der Beantwortung unserer Fragestellung beginnen.

Kann man anhand der nordamerikanischen Verkäufe voraussagen, wie sich ein Genre im europäischen Markt verkaufen wird?

Da es einige Ausreisser gibt, z.B wenn sich ein Spiel in einer Region gar nicht verkauft wurde, haben wir einen Filter eingebaut, welche Sales unter 1.0 nicht berücksichtigt.

Unten haben wir die besten Fits genommen, da bei den anderen Spielgenres der r-squared Wert unter 50% lag. Dort ist also kein Zusammenhang zu erkennen.

# Create DataFrame only with Racing games
df_racing <- df_clean %>%
  filter(
    Genre == "Racing",
    NA_Sales > 1.00,
    EU_Sales > 1.00
  )

ggplot(df_racing, aes(x=EU_Sales, y=NA_Sales)) + 
  geom_point() + 
  geom_smooth(method = "lm", se=FALSE) +
  labs(title = "Racing Game Sales Overview")

`geom_smooth()` using formula 'y ~ x'

# Create linear model
mdl_racing <- lm(EU_Sales ~ NA_Sales, data = df_racing)

# Extract model score
mdl_racing %>%
  glance() %>%
  pull(r.squared)

[1] 0.8686435

# Predict EU Sales for a Racing Game based on NA Sales
predict_racing <- tibble(NA_Sales = 5)
predict(mdl_racing, predict_racing)

       1 
3.891789 

Wenn ein Racing Game in Nord Amerika 5 Millionen Verkäufe aufweist, liegt die Verkaufs-Vorhersage für Europa bei rund 3.9 Millionen.

# Create DataFrame only with Role-Playing games
df_role <- df_clean %>%
  filter(
    Genre == "Role-Playing",
    NA_Sales > 1.00,
    EU_Sales > 1.00
  )

ggplot(df_role, aes(x=EU_Sales, y=NA_Sales)) + 
  geom_point() + 
  geom_smooth(method = "lm", se=FALSE) +
  labs(title = "Role-Playing Game Sales Overview")

`geom_smooth()` using formula 'y ~ x'

# Create linear model
mdl_rp <- lm(EU_Sales ~ NA_Sales, data = df_role)

# Extract model score
mdl_rp %>%
  glance() %>%
  pull(r.squared)

[1] 0.8433709

# Predict EU Sales for a Role-Playing Game based on NA Sales
predict_rp <- tibble(NA_Sales = 5)
predict(mdl_rp, predict_rp)

       1 
3.451286 

# Create DataFrame only with Shooter games
df_shooter <- df_clean %>%
  filter(
    Genre == "Shooter",
    NA_Sales > 0.00,
    EU_Sales > 0.00
  )

# Create DataFrame only with Shooter games without Duck Hunt
df_shooter_no_duckhunt <- df_clean %>%
  filter(
    Genre == "Shooter",
    NA_Sales > 0.00,
    Name != "Duck Hunt",
    EU_Sales > 0.00
  )

# Create subplots
p1 <- ggplot(df_shooter, aes(x=EU_Sales, y=NA_Sales)) + 
  geom_point() + 
  geom_smooth(method = "lm", se=FALSE) +
  labs(title = "Shooter Game Sales")

p2 <- ggplot(df_shooter_no_duckhunt, aes(x=EU_Sales, y=NA_Sales)) + 
  geom_point() + 
  geom_smooth(method = "lm", se=FALSE) +
  labs(title = "Shooter Game Sales no Duck Hunt")

# Plot both plots side by side
grid.arrange(p1, p2, ncol = 2)  

`geom_smooth()` using formula 'y ~ x'
`geom_smooth()` using formula 'y ~ x'

# Create linear model
mdl_shooter <- lm(EU_Sales ~ NA_Sales, data = df_shooter)

# Extract model score
mdl_shooter %>%
  glance() %>%
  pull(r.squared)

[1] 0.4244135

# Create linear model
mdl_shooter_no_duckhunt <- lm(EU_Sales ~ NA_Sales, data = df_shooter_no_duckhunt)

# Extract model score
mdl_shooter_no_duckhunt %>%
  glance() %>%
  pull(r.squared)

[1] 0.6858556

Wie wir hier anhand der R-Squared sehen, fitted das Modell viel besser ohne Duck Hunt. Dies liegt daran, dass dieses Spiel in Nord Amerika zusammen mit der Konsole verkauft wurde, nicht wie in Europa. Darum ist dies für uns einen Ausreisser und wir wollten diese Genre ohne Ausreisser visualisieren und modellieren.

Aber da das Modell auch ohne Duck Hunt nicht gut sehr gut ist, werden wir mit diesem Genre keine Vorhersagen durchführen.

# Create DataFrame only with Simulation games
df_sim <- df_clean %>%
  filter(
    Genre == "Simulation",
    NA_Sales > 1.00,
    EU_Sales > 1.00
)

ggplot(df_sim, aes(x=EU_Sales, y=NA_Sales)) + 
  geom_point() + 
  geom_smooth(method = "lm", se=FALSE) +
  labs(title = "Simulation Game Sales Overview")

`geom_smooth()` using formula 'y ~ x'

# Create linear model
mdl_sim <- lm(EU_Sales ~ NA_Sales, data = df_sim)

# Extract model score
mdl_sim %>%
  glance() %>%
  pull(r.squared)

[1] 0.9233418

# Predict EU Sales for a Simulation Game based on NA Sales
predict_sim <- tibble(NA_Sales = 5)
predict(mdl_sim, predict_sim)

       1 
5.474846 

Wenn ein Simulation Game in NA 5 Million Verkäufe aufweist, liegt die Vorhersage für EU bei 5.4 Millionen.

# Create DataFrame only with Sport games
df_sport <- df_clean %>%
  filter(
    Genre == "Sports",
    NA_Sales > 1.00,
    EU_Sales > 1.00
  )

ggplot(df_sport, aes(x=EU_Sales, y=NA_Sales)) + 
  geom_point() + 
  geom_smooth(method = "lm", se=FALSE) +
  labs(title = "Sport Game Sales Overview")

`geom_smooth()` using formula 'y ~ x'

# Create linear model
mdl_sport <- lm(EU_Sales ~ NA_Sales, data = df_sport)

# Extract model score
mdl_sport %>%
  glance() %>%
  pull(r.squared)

[1] 0.9488926

# Predict EU Sales for a Sport Game based on NA Sales
predict_sport <- tibble(NA_Sales = 5)
predict(mdl_sport, predict_sport)

       1 
4.019965 

Wenn ein Sport Game in NA 5 Million Verkäufe aufweist, liegt die Vorhersage für EU bei 4 Millionen.

Residuenanalyse (zum beurteilen ob das Modell gut ist)

• Residuen erwartungswert von 0
• Residuen sind voneinander unabhängig
• Residuen sind normalverteilt

# Create Residual Scatterplot

df <- augment(mdl_racing)

ggplot(df, aes(x = 1:nrow(df), y = .resid)) + 
  geom_point() +
  geom_hline(yintercept=0, color="Red") +
  ggtitle("Residuals Model Racing Genre") +
  xlab("")

# Create Residual Histogram (to see if the data is a normal distribution)

ggplot(df_racing, aes(x = mdl_racing$residuals)) + 
  geom_histogram(bins = 30) +
  geom_density(color = "Red") +
  ggtitle("Residuals Model Racing Genre") +
  xlab("residuals")

Das Histogramm ist nicht ganz genau wie eine Normalverteilung aber könnte trotzdem als eine akzeptiert sein.

# Create Residual Scatterplot

df <- augment(mdl_rp)

ggplot(df, aes(x = 1:nrow(df), y = .resid)) + 
  geom_point() +
  geom_hline(yintercept=0, color="Red") +
  ggtitle("Residuals Model Role-Playing Genre") +
  xlab("")

# Create Residual Histogram (to see if the data is a normal distribution)

ggplot(df_role, aes(x = mdl_rp$residuals)) + 
  geom_histogram(bins = 30) +
  geom_density(color = "Red") +
  ggtitle("Residuals Model Role-Playing Genre") +
  xlab("residuals")

Das Histogramm ist nicht ganz genau wie eine Normalverteilung aber könnte trotzdem als eine akzeptiert sein.

# Create Residual Scatterplot

df <- augment(mdl_sim)

ggplot(df, aes(x = 1:nrow(df), y = .resid)) + 
  geom_point() +
  geom_hline(yintercept=0, color="Red") +
  ggtitle("Residuals Model Simulation Genre") +
  xlab("")

# Create Residual Histogram (to see if the data is a normal distribution)

ggplot(df_sim, aes(x = mdl_sim$residuals)) + 
  geom_histogram(bins = 30) +
  geom_density(color = "Red") +
  ggtitle("Residuals Model Simulation Genre") +
  xlab("residuals")

Das Histogramm ist nicht ganz genau wie eine Normalverteilung aber könnte trotzdem als eine akzeptiert sein.

# Create Residual Scatterplot

df <- augment(mdl_sport)

ggplot(df, aes(x = 1:nrow(df), y = .resid)) + 
  geom_point() +
  geom_hline(yintercept=0, color="Red") +
  ggtitle("Residuals Model Sport Genre") +
  xlab("")

# Create Residual Histogram (to see if the data is a normal distribution)

ggplot(df_sport, aes(x = mdl_sport$residuals)) + 
  geom_histogram(bins = 50) +
  geom_density(color = "Red") +
  ggtitle("Residuals Model Sport Genre") +
  xlab("residuals")

Das Histogramm ist nicht ganz genau wie eine Normalverteilung aber könnte trotzdem als eine akzeptiert sein.

How closely related are North American and European video game sales? How do sales in Japan compare to North America and Europe?

# Color the SPLOM of NA_Sales, EU_Sales, and JP_Sales by nintendo
df_clean %>%
  plot_ly(color = ~Genre) %>% 
  add_trace(
    type = 'splom',
    dimensions = list(
      list(label = 'N. America', values = ~NA_Sales),
      list(label = 'Europe', values = ~EU_Sales),    
      list(label = 'Japan', values = ~JP_Sales)       
    )
  )

Warning in RColorBrewer::brewer.pal(N, "Set2") :
  n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors

Warning in RColorBrewer::brewer.pal(N, "Set2") :
  n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors

Warning in RColorBrewer::brewer.pal(N, "Set2") :
  n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors

Warning in RColorBrewer::brewer.pal(N, "Set2") :
  n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors

Nintendo Spiele verkaufen sich besser als Electronic Arts auf der ganzen Welt.

Mit dieser Fragestellung wollen wir herausfinden ob sich die Nintendo Konsole in Japan besser verkauft.

# Create DataFrame with only Nintendo and Sony as Publisher
publishers = c("Nintendo", "Electronic Arts")

df_publisher <- df_clean %>%
  filter(
    Publisher %in% publishers
    )

df_publisher

# Replace publisher name with 0 and 1
df_publisher$Publisher[df_publisher$Publisher == "Electronic Arts"] <- 0
df_publisher$Publisher[df_publisher$Publisher == "Nintendo"] <- 1

# Save as int
df_publisher$Publisher <- as.numeric(df_publisher$Publisher)

# Create logistic model
mdl_publisher <- glm(Publisher ~ NA_Sales, data = df_publisher, family = binomial())

ggplot(df_publisher, aes(x=Global_Sales, y=Publisher)) + 
  geom_point(alpha=.5, color="Blue") +
  stat_smooth(method="glm", col = "Red", se=FALSE, method.args = list(family=binomial)) +
  labs(
    x = "Sales (million)",
    y = "1=Nintendo / 0=Electronic Arts",
    title = "Probability that a game is from Nintendo based on global sales"
  )

`geom_smooth()` using formula 'y ~ x'

Wir können hier gut sehen, dass Nintendo viel erfolgreichere Spiele produziert haben. Dies deutet auch an, dass Nintendo beliebter ist als Electronic Arts

Wii Spiele verkaufen sich besser wie DS Spiele in Japan

# Create DataFrame with only Wii and DS as Platforms
platforms = c("Wii", "DS")

df_platform <- df_clean %>%
  filter(
    Platform %in% platforms
    )

df_platform

# Replace platform name with 0 and 1
df_platform$Platform[df_platform$Platform == "Wii"] <- 0
df_platform$Platform[df_platform$Platform == "DS"] <- 1

# Save as int
df_platform$Platform <- as.numeric(df_platform$Platform)

# Create logistic model
mdl_platform <- glm(Platform ~ JP_Sales, data = df_platform, family = binomial())

ggplot(df_platform, aes(x=JP_Sales, y=Platform)) + 
  geom_point(alpha=.2, color="Blue") +
  stat_smooth(method="glm", col = "Red", se=FALSE, method.args = list(family=binomial)) +
  labs(
    x = "Sales (million)",
    y = "1=Wii / 0=DS",
    title = "Probability that a game is from Wii based on sales in Japan"
  )

`geom_smooth()` using formula 'y ~ x'

Anhand des Plots ist zu sehen, dass ein Spiel mit über 2 mio Verkäufe eher über das Platform Wii verkauft wurde. Dies deutet an, dass das Wii beliebter als das Nintendo DS ist.

Fazit

Bei den meisten Genren ist es nicht möglich die Verkäufe in Europa anhand der Verkäufe in Nord Amerika vorherzusagen. Wir haben jedoch einige Genren gefunden, bei denen Vorhersagen möglich ist: - Racing - Role-Playing - Simulation - Sport

Sehr interessant zu sehen war die Genre Simulation. Unser Modell, die bei 92% Genauigkeit liegt sagt voraus, dass ein beliebiges Spiel in der EU besser verkauft wird als in Nord Amerika. Bei allen anderen Genren verkaufen sich die Spiele in Nord Amerika besser.